home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-06
/
btp15.zip
/
EXAMPLE1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-11-08
|
7KB
|
253 lines
PROGRAM Example1; { (C) 1991 John C. Leon last updated 11/5/91 }
{Use Btrieve data file EXAMPLE created with CREATE.PAS}
{$IFDEF production} {$D-,R-,L-,S-} {$ENDIF}
USES
Crt, BTP;
TYPE
ExampleFields = record
case integer of
1: (First : array[1..10] of char; {define 3 fields }
Last : array[1..20] of char;
KeyBuf : array[1..20] of char);{size to largest key }
2: (DBuffer : array[1..30] of char);{size to rec length }
3: (Position: array[1..2] of word); {high word first! }
end; {useful after GETPOS }
PExample = ^ExampleFile;
ExampleFile = object(BFile)
Fields : ExampleFields;
constructor Init;
function BT(OpCode, Key:integer):integer; virtual;
procedure SetFields;
procedure GetFields;
function GetNumRecs:longint;
function GetName: string;
procedure SetKeyZero;
procedure SetKeyOne;
end;
VAR
Example : PExample;
FName : string[10];
LName : string[20];
Name : string;
NumberRecords,
Position : longint;
(* Define methods of ExampleFile *)
(* ------------------------------------------------------------------------ *)
constructor ExampleFile.Init;
begin
BFile.Init('example', Accel); {Open file in accelerated mode.}
end;
function ExampleFile.BT(OpCode, Key:integer):integer;
begin
DBufferLen := Specs.RecLen;
BT := Btrv(OpCode, PosBlk, Fields, DBufferLen, Fields.KeyBuf, Key);
end;
procedure ExampleFile.SetFields;
var Counter:integer;
begin
with Fields do
begin
for Counter := 1 to length(FName) do
First[Counter] := FName[Counter];
if length(FName) < 10 then
for Counter := length(FName)+1 to 10 do
First[Counter] := ' ';
for Counter := 1 to length(LName) do
Last[Counter] := LName[Counter];
if length(LName) < 20 then
for Counter := length(LName)+1 to 20 do
Last[Counter] := ' ';
end;
end;
procedure ExampleFile.GetFields;
begin
with Fields do
begin
FName := First;
LName := Last;
end;
end;
function ExampleFile.GetNumRecs: longint;
begin
GetNumRecs := NumRecs;
end;
function ExampleFile.GetName: string;
var
First, Last : string;
begin
First := RTrim(Fields.First);
Last := RTrim(Fields.Last);
GetName := First + ' ' + Last;
end;
procedure ExampleFile.SetKeyZero;
var
Counter: integer;
begin
with Fields do
begin
for Counter := 1 to length(LName) do
KeyBuf[Counter] := LName[Counter];
if length(LName) < 20 then
for Counter := length(LName) + 1 to 20 do
KeyBuf[Counter] := ' ';
end;
end;
procedure ExampleFile.SetKeyOne;
var
Counter: integer;
begin
with Fields do
begin
for Counter := 1 to length(FName) do
KeyBuf[Counter] := FName[Counter];
if length(FName) < 10 then
for Counter := length(FName) + 1 to 10 do
KeyBuf[Counter] := ' ';
end;
end;
(* End of method definitions for ExampleFile *)
(* ------------------------------------------------------------------------ *)
procedure ShowResults;
begin
Name := Example^.GetName;
writeln(Name);
writeln('Status = ', BStatus, '. Hit enter.');
readln;
end;
procedure DoAnInsert;
begin
write('Enter First Name (max 10): ');
readln(FName);
write('Enter Last Name (max 20): ');
readln(LName);
Example^.SetFields;
BStatus := Example^.BT(BInsert, Zero);
if BStatus = Zero then
begin
writeln('Record inserted OK. Hit enter to continue.');
readln;
end
else
begin
writeln;
writeln;
writeln('Error in insert op...Status = ', BStatus);
writeln('Hit <Enter> to continue.'); {example program will now go }
readln; {on to DoTestOtherOps }
clrscr;
end;
end; {procedure DoAnInsert}
procedure DoTestOtherOps;
var
Counter: integer;
begin
BStatus := Example^.Close; {Close after insert for grins}
Example^.Init; {Reinitialize the entire object from scratch. Easy!}
clrscr;
{NOW DOING A GET FIRST}
writeln('Doing get first on key zero.');
BStatus := Example^.BT(BGetFirst, Zero);
ShowResults;
{NOW DO 5 GET NEXT OPS}
writeln('Now getting 5 next.');
for Counter := 1 to 5 do
begin
BStatus := Example^.BT(BGetNext, Zero);
Name := Example^.GetName;
writeln(Name);
end;
writeln('Status of fifth Get Next is ', BStatus, '. Hit enter.');
readln;
{NOW DO GET PREV OP}
writeln('Now getting previous:');
BStatus := Example^.BT(BGetPrev, Zero);
ShowResults;
{NOW DO GET EQUAL OP ON 'LEON'}
LName := 'Leon';
Example^.SetKeyZero; {sets keybuf to 'Leon' padded by blanks}
writeln('Now doing get equal on "', Example^.Fields.KeyBuf, '".');
BStatus := Example^.BT(BGetEqual, Zero);
ShowResults;
{NOW DO GET EQUAL OP ON 'JOHN' IN KEY ONE}
FName := 'John';
Example^.SetKeyOne;
writeln('Now doing get equal on key 1..."', Example^.Fields.KeyBuf, '".');
BStatus := Example^.BT(BGetEqual, 1);
ShowResults;
{NOW DO GET LESS THAN OP}
LName := 'Leon';
Example^.SetKeyZero;
writeln('Now doing less than on "', Example^.Fields.KeyBuf, '".');
BStatus := Example^.BT(BGetLess, Zero);
ShowResults;
{NOW DO GET LESS THAN OR EQUAL OP}
LName := 'Leon';
Example^.SetKeyZero;
writeln('Now doing less than or equal to on "', Example^.Fields.KeyBuf, '".');
BStatus := Example^.BT(BGetLessEq, Zero);
ShowResults;
{NOW DO GET LAST OP}
writeln('Now getting last in index path: ');
BStatus := Example^.BT(BGetLast, Zero);
ShowResults;
{SHOW PHYSICAL POSITION OF LAST RECORD}
BStatus := Example^.BT(BGetPos, Zero);
Position := Example^.Fields.Position[2] + Example^.Fields.Position[1]*65536;
writeln;
writeln('Position (offset into file) of last record in path is ', Position);
BStatus := Example^.Close; {close and reInit to get stats}
Example^.Init;
NumberRecords := Example^.GetNumRecs;
writeln('Total Number of Records is: ', NumberRecords, '. Hit enter.');
readln;
end;
(* begin main program code *)
(* ------------------------------------------------------------------------ *)
VAR
Response: string;
BEGIN
Example := new(PExample, Init);
repeat
clrscr;
DoAnInsert;
DoTestOtherOps;
write('Continue? (y/n): ');
readln(Response);
until (Response='N') or (Response='n');
BStatus := Example^.Close;
if BStatus <> 0 then
writeln('Problem closing file. Status = ', BStatus, '.');
dispose(Example, Done);
END.